home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / DIALOGS / MSGDLG11 / FRMDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-26  |  7KB  |  239 lines
  1. unit Frmdemo;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Classes, Graphics, Controls, Forms,
  7.   MsgDlg, StdCtrls, Buttons, ExtCtrls, Dialogs;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel1: TPanel;
  12.     bShowDlg: TBitBtn;
  13.     bClose: TBitBtn;
  14.     MessageDialog1: TMessageDialog;
  15.     GroupBox1: TGroupBox;
  16.     GroupBox2: TGroupBox;
  17.     RBConfirmation: TRadioButton;
  18.     RBCustom: TRadioButton;
  19.     RBError: TRadioButton;
  20.     RBInformation: TRadioButton;
  21.     RBWarning: TRadioButton;
  22.     tCaption: TEdit;
  23.     tMessageText: TEdit;
  24.     Label1: TLabel;
  25.     Label2: TLabel;
  26.     GroupBox3: TGroupBox;
  27.     RBWin31: TRadioButton;
  28.     RBWin95: TRadioButton;
  29.     Panel2: TPanel;
  30.     Label3: TLabel;
  31.     Label4: TLabel;
  32.     Label5: TLabel;
  33.     Label6: TLabel;
  34.     cbYes: TCheckBox;
  35.     cbNo: TCheckBox;
  36.     cbOK: TCheckBox;
  37.     cbRetry: TCheckBox;
  38.     cbIgnore: TCheckBox;
  39.     cbCancel: TCheckBox;
  40.     cbAll: TCheckBox;
  41.     cbHelp: TCheckBox;
  42.     cbAbort: TCheckBox;
  43.     GroupBox4: TGroupBox;
  44.     rbBGYes: TRadioButton;
  45.     rbBGNo: TRadioButton;
  46.     GroupBox5: TGroupBox;
  47.     rbCYes: TRadioButton;
  48.     rbCNo: TRadioButton;
  49.     tLeft: TEdit;
  50.     tTop: TEdit;
  51.     Label8: TLabel;
  52.     Label9: TLabel;
  53.     GroupBox6: TGroupBox;
  54.     rbSNone: TRadioButton;
  55.     rbSAsterix: TRadioButton;
  56.     rbSCriticalStop: TRadioButton;
  57.     rbSDefault: TRadioButton;
  58.     rbSQuestion: TRadioButton;
  59.     rbSExclamation: TRadioButton;
  60.     Label10: TLabel;
  61.     RBAutoDetect: TRadioButton;
  62.     GroupBox7: TGroupBox;
  63.     cbDB: TComboBox;
  64.     GroupBox8: TGroupBox;
  65.     rbMCYes: TRadioButton;
  66.     rbMCNo: TRadioButton;
  67.     Label11: TLabel;
  68.     tMinWidth: TEdit;
  69.     Label7: TLabel;
  70.     BitBtn1: TBitBtn;
  71.     procedure bShowDlgClick(Sender: TObject);
  72.     procedure bCloseClick(Sender: TObject);
  73.     procedure rbCNoClick(Sender: TObject);
  74.     procedure rbCYesClick(Sender: TObject);
  75.     procedure tLeftKeyPress(Sender: TObject; var Key: Char);
  76.     procedure tMinWidthKeyPress(Sender: TObject; var Key: Char);
  77.     procedure tMinWidthExit(Sender: TObject);
  78.     procedure FormCreate(Sender: TObject);
  79.     procedure BitBtn1Click(Sender: TObject);
  80.   private
  81.     { Private declarations }
  82.   public
  83.     { Public declarations }
  84.   end;
  85.  
  86. var
  87.   Form1: TForm1;
  88.  
  89. implementation
  90.  
  91. {$R *.DFM}
  92.  
  93. procedure TForm1.bShowDlgClick(Sender: TObject);
  94. var
  95.   Buttons : TMsgDlgButtons;
  96. begin
  97.   { DialogButtons }
  98.   Buttons := [];
  99.   If cbYes.Checked then Buttons := [mbYes];
  100.   If cbNo.Checked then Buttons := Buttons + [mbNo];
  101.   If cbOK.Checked then Buttons := Buttons + [mbOK];
  102.   If cbCancel.Checked then Buttons := Buttons + [mbCancel];
  103.   If cbAbort.Checked then Buttons := Buttons + [mbAbort];
  104.   If cbRetry.Checked then Buttons := Buttons + [mbRetry];
  105.   If cbIgnore.Checked then Buttons := Buttons + [mbIgnore];
  106.   If cbAll.Checked then Buttons := Buttons + [mbAll];
  107.   If cbHelp.Checked then Buttons := Buttons + [mbHelp];
  108.  
  109.   With MessageDialog1 do Begin
  110.     { Caption }
  111.     Caption := tCaption.text;
  112.     { Text }
  113.     Text := tMessageText.text;
  114.     { DialogType }
  115.     If      RBConfirmation.Checked then DialogType := mtConfirmation
  116.     else if RBCustom.Checked then DialogType := mtCustom
  117.     else if RBError.Checked then DialogType := mtError
  118.     else if RBInformation.Checked then DialogType := mtInformation
  119.     else if RBWarning.Checked then DialogType := mtWarning;
  120.     { DialogStyle }
  121.     If RBAutoDetect.Checked then DialogStyle := dsAutoDetect
  122.     else if RBWin31.Checked then DialogStyle := dsWin31
  123.     else DialogStyle := dsWin95;
  124.     { DialogButtons }
  125.     DialogButtons := Buttons;
  126.     { ButtonGlyphs }
  127.     If rbBGYes.Checked then ButtonGlyphs := True
  128.     else ButtonGlyphs := False;
  129.     { Centered }
  130.     If rbCYes.Checked then Centered := True
  131.     else Begin
  132.       Centered := False;
  133.       DialogLeft := StrToInt(tLeft.Text);
  134.       DialogTop := StrToInt(tTop.Text);
  135.     End;
  136.     { Sound }
  137.     If rbSNone.Checked then DialogSound := dsNone
  138.     else if rbSAsterix.Checked then DialogSound := dsAsterix
  139.     else if rbSCriticalStop.Checked then DialogSound := dsCriticalStop
  140.     else if rbSDefault.Checked then DialogSound := dsDefault
  141.     else if rbSExclamation.Checked then DialogSound := dsExclamation
  142.     else if rbSQuestion.Checked then DialogSound := dsQuestion;
  143.     { DefaultButton }
  144.     If cbDB.ItemIndex <> -1 then
  145.     Case cbDB.ItemIndex of
  146.       0: DefaultButton := mbYes;
  147.       1: DefaultButton := mbNo;
  148.       2: DefaultButton := mbOk;
  149.       3: DefaultButton := mbCancel;
  150.       4: DefaultButton := mbAbort;
  151.       5: DefaultButton := mbRetry;
  152.       6: DefaultButton := mbIgnore;
  153.       7: DefaultButton := mbAll;
  154.       8: DefaultButton := mbHelp;
  155.     end;
  156.     { MoveCursor }
  157.     If rbMCYes.Checked then MoveCursor := True
  158.     else if rbMCNo.Checked then MoveCursor := False;
  159.     { MinWidth }
  160.     MinWidth := StrToInt(tMinWidth.Text);
  161.  
  162.     Execute; { Show the Dialog }
  163.   End;
  164.  
  165. end;
  166.  
  167. procedure TForm1.bCloseClick(Sender: TObject);
  168. begin
  169.   Close;
  170. end;
  171.  
  172. procedure TForm1.rbCNoClick(Sender: TObject);
  173. begin
  174.   tLeft.Enabled := True;
  175.   tTop.Enabled := True;
  176. end;
  177.  
  178. procedure TForm1.rbCYesClick(Sender: TObject);
  179. begin
  180.   tLeft.Enabled := False;
  181.   tTop.Enabled := False;
  182. end;
  183.  
  184. procedure TForm1.tLeftKeyPress(Sender: TObject; var Key: Char);
  185. begin
  186.   If Key = #8 then Exit;
  187.   If (Key < #48) or (Key > #57) then Key := #0;
  188. end;
  189.  
  190. procedure TForm1.tMinWidthKeyPress(Sender: TObject; var Key: Char);
  191. begin
  192.   If Key = #8 then Exit;
  193.   If (Key < #48) or (Key > #57) then Key := #0;
  194. end;
  195.  
  196. procedure TForm1.tMinWidthExit(Sender: TObject);
  197. var
  198.   Number: Integer;
  199. begin
  200.   If tMinWidth.Text <> '' then
  201.   begin
  202.     Number := StrToInt(tMinWidth.Text);
  203.     If (Number < 150) or (Number > Screen.Width) then
  204.     begin
  205.       MessageDialog1.MsgDlg('You must enter a number be!!! 150 and '
  206.         + IntToStr(Screen.Width) + '!','I''m Warning You...',
  207.         mtInformation, [mbOk], mbOk, 0);
  208.       tMinWidth.SetFocus;
  209.       tMinWidth.Text := '150';
  210.     end;
  211.   end;
  212. end;
  213.  
  214. procedure TForm1.FormCreate(Sender: TObject);
  215. begin
  216.   cbDB.ItemIndex := 1;
  217. end;
  218.  
  219. procedure TForm1.BitBtn1Click(Sender: TObject);
  220. begin
  221. {<<<>>> Declaration of the Function MsgDlg <<<>>>
  222.  
  223.   function MsgDlg(Const Text, Caption: String; MsgDlgType: TMsgDlgType;
  224.     MsgDlgButtons: TMsgDlgButtons; MsgDlgDefaultButton: TMsgDlgBtn;
  225.     HelpCtx: LongInt): TModalResult;
  226. }
  227.  
  228.   MessageDialog1.MsgDlg( { Text } 'This Dialog is displayed using the ' +
  229.       'function "MsgDlg". You can use this method to pass at once the ' +
  230.       'Text, Caption, DialogType, DialogButtons, DefaultButton and ' +
  231.       'HelpContext parameters.\n\nCheck out the source code of this ' +
  232.       'button for more information...',
  233.       { Caption } 'Caption', { DialogType } mtInformation,
  234.       { DialogButtons } [mbOk], { DefaultButton } mbOk,{ Context ID } 0);
  235.       { You do not have to use the Execute Method! }
  236. end;
  237.  
  238. end.
  239.